home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 20 / Cream of the Crop 20 (Terry Blount) (1996).iso / program / vol15n11.zip / TBWIZ.ZIP / LIBRARY.BAS < prev    next >
BASIC Source File  |  1996-02-21  |  13KB  |  422 lines
  1. Attribute VB_Name = "LIBRARY"
  2. '___general purpose library routines
  3.  
  4. Option Explicit
  5. Option Compare Text
  6. DefInt A-Z
  7. Global DownY%
  8. Global MyFile$
  9. Global CommentChanged%
  10. Global CurrentItem$
  11. Global MyCRLF$
  12. #If Win32 = 0 Then
  13.     Declare Function WritePrivateProfileString% Lib "Kernel" (ByVal lpApplicationName$, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lplFileName$)
  14.     Declare Function WriteProfileString% Lib "Kernel" (ByVal lpApplicationName$, ByVal lpKeyName As Any, ByVal lpString$)
  15.     Declare Function GetProfileInt% Lib "Kernel" (ByVal lpAppName$, ByVal lpKeyName$, ByVal nDefault%)
  16.     Declare Function GetPrivateProfileInt% Lib "Kernel" (ByVal lpApplicationName$, ByVal lpKeyName$, ByVal nDefault%, ByVal lpFileName$)
  17.     Declare Function GetPrivateProfileString% Lib "Kernel" (ByVal lpApplicationName As Any, ByVal lpKeyName As Any, ByVal lpDefault$, ByVal lpReturnedString$, ByVal nSize%, ByVal lpFileName$)
  18.     Declare Function GetProfileString% Lib "Kernel" (ByVal lpAppName$, ByVal lpKeyName As Any, ByVal lpDefault$, ByVal lpReturnedString$, ByVal nSize%)
  19.     Declare Function GetVersion Lib "Kernel" () As Integer
  20.     Declare Sub GetClientRect Lib "User" (ByVal hwnd As Integer, lpRect As Rect)
  21.     Declare Function GetFocus Lib "User" () As Integer
  22.     Declare Sub BringWindowToTop Lib "User" (ByVal hwnd As Integer)
  23.     Declare Function SetFocusAPI Lib "User" Alias "SetFocus" (ByVal hwnd As Integer) As Integer
  24. #Else
  25.     Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
  26.     Declare Function WriteProfileString Lib "kernel32" Alias "WriteProfileStringA" (ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Long
  27.     Declare Function GetProfileInt Lib "kernel32" Alias "GetProfileIntA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal nDefault As Long) As Long
  28.     Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As Any, ByVal lpDefault As Any, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
  29.     Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
  30.     Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
  31.     Declare Function GetVersion Lib "kernel32" () As Long
  32. '    Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As Rect) As Long
  33.     Declare Function GetFocus Lib "user32" () As Long
  34.     Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
  35.     Declare Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) As Long
  36. #End If
  37. Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
  38. Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As String) As Long
  39. Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
  40. Const vbd$ = " - Microsoft Visual Basic (design)"
  41.  
  42.  
  43. Sub SetParentByCaption(Cap$, NewChild&)
  44. 'set parent window
  45. Dim i&
  46. Cap$ = Cap$ & vbd$
  47. i& = FindWindow(0&, Cap$)
  48. If IsWindow(i&) <> 0 Then i& = SetParent(NewChild&, i&)
  49. End Sub
  50.  
  51. Function GetListItem$(ByVal Source$, ByVal MyItem%, Sep$)
  52.   If MyItem% > 0 Then MyItem% = MyItem% - 1
  53.   Dim basepos%, thispos%, sepLen%, Cap$, nt%, res$, SourceLen%
  54.   basepos% = 1
  55.   thispos% = 0
  56.   If Left$(Source$, 1) = Sep$ Then Source$ = Mid$(Source$, 2)
  57.   SourceLen% = Len(Source$)
  58.   sepLen% = Len(Sep$)
  59.   If SourceLen% = 0 Then
  60.     Cap$ = ""
  61.   Else
  62.     If Right$(Source$, sepLen%) <> Sep$ Then Source$ = Source$ + Sep$
  63.     Do
  64.       nt% = InStr(basepos% + 1, Source$, Sep$)
  65.       If nt% = 0 Then nt% = SourceLen% + 1
  66.       ' Now points to next tab or 1 past end of string
  67.       If thispos% = MyItem% Then
  68.         If nt% - (basepos% - 1) < 0 Then
  69.           res$ = ""
  70.         Else
  71.           res$ = Mid$(Source$, basepos%, nt% - (basepos%))
  72.         End If
  73.         Exit Do
  74.       End If
  75.       basepos% = nt% + sepLen%
  76.       If nt% <> 1 Then thispos% = thispos% + 1
  77.     Loop While basepos% <= SourceLen%
  78.     GetListItem$ = res$
  79.   End If
  80. End Function
  81.  
  82. Sub Alert(Mess$)
  83. '  * creates an Alert box with an OK button
  84. MsgBox Mess$, 48, App.Title
  85. End Sub
  86.  
  87.  
  88. Function exGetName$(myF$)
  89. Dim N%
  90.   Do
  91.     N% = InStr(myF$, "\")
  92.     If N% > 0 Then myF$ = Right$(myF$, Len(myF$) - N%)
  93.   Loop While N% > 0
  94. exGetName$ = myF$
  95. End Function
  96.  
  97. Function ExtractFileExt$(ByVal F$)
  98. Dim i%
  99. i% = InStr(F$, ".")
  100. If i% > 0 And i% < Len(F$) Then
  101.     ExtractFileExt$ = Mid$(F$, i% + 1)
  102.   Else
  103.     ExtractFileExt$ = ""
  104.   End If
  105.  
  106. End Function
  107.  
  108. Function ExtractFileRoot$(ByVal F$)
  109.   ' Return the basename portion of a full pathname
  110.   Dim N%
  111.   F$ = exGetName(F$)
  112.   N% = InStr(F$, ".")
  113.   If N% > 0 Then ExtractFileRoot$ = Left$(F$, N% - 1)
  114. End Function
  115.  
  116. Function GetWinIniList$(pApp$)
  117. Dim x%
  118. Dim ret As String * 1024
  119. Dim pDefault$
  120. x% = GetPrivateProfileString(pApp$, "", pDefault$, ret, Len(ret), "WIN.INI")
  121. If x% > 0 Then GetWinIniList$ = Left$(ret, x%)
  122.  
  123.  
  124. End Function
  125.  
  126. Sub MsgExclaim(MyMsg$)
  127. MsgBox MyMsg$, vbExclamation, App.Title
  128. End Sub
  129.  
  130. Sub MsgInform(MyMsg$)
  131. MsgBox MyMsg$, vbInformation, App.Title
  132. End Sub
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140. Sub WinCenter(F As Form)
  141. F.Move (Screen.Width - F.Width) / 2, (Screen.Height - F.Height) / 2
  142. End Sub
  143.  
  144. Function CheckForWin95%()
  145.       Dim i%, lowbyte$, highbyte$
  146.       i% = GetVersion()
  147.       ' Lowbyte is derived by masking off high byte.
  148.       lowbyte$ = Str$(i% And &HFF)
  149.       ' Highbyte is derived by masking off low byte and shifting.
  150.       highbyte$ = LTrim$(Str$((i% And &HFF00) / 256))
  151.       ' Assign Windows version to text property.
  152.  
  153.       If Val(lowbyte$ + "." + highbyte$) > 3.8 Then
  154.         CheckForWin95% = True
  155.       Else
  156.         CheckForWin95% = False
  157.       End If
  158.  
  159.    End Function
  160.  
  161.  
  162.  
  163. Sub DelPrivIniItem(pApp$, pkey$, pFile$)
  164. Dim x%
  165. x% = WritePrivateProfileString(pApp$, pkey$, 0&, pFile$)
  166. End Sub
  167.  
  168. Sub DelPrivIniSection(pApp$, pFile$)
  169. Dim x%
  170. x% = WritePrivateProfileString(pApp$, 0&, 0&, pFile$)
  171. End Sub
  172.  
  173. Function ExtractFileName$(ByVal F$)
  174.   ExtractFileName$ = exGetName(F$)
  175.  
  176. End Function
  177.  
  178. Function GetPrivINI$(pApp$, pkey$, pFile$)
  179. Dim x%, pDefault$
  180. Dim ret As String * 1024
  181.  
  182. x% = GetPrivateProfileString(pApp$, pkey$, pDefault$, ret, Len(ret), pFile$)
  183. If x% > 0 Then GetPrivINI$ = Left$(ret, x%)
  184. End Function
  185.  
  186. Function GetPrivIniInt%(pApp$, pkey$, pFile$)
  187. Dim pDefault%
  188. GetPrivIniInt% = GetPrivateProfileInt(pApp$, pkey$, pDefault%, pFile$)
  189. End Function
  190.  
  191. Function CountListItems%(Source$, Sep$)
  192. Dim counter%, i%, sepLen%, SourceLen%
  193. Source$ = Trim$(Source$)
  194. sepLen% = Len(Sep$)
  195. If Right$(Source$, sepLen%) <> Sep$ Then Source$ = Source$ + Sep$
  196. SourceLen% = Len(Source$)
  197. If SourceLen% = sepLen% Then
  198.     CountListItems% = 0
  199. Else
  200.     i% = InStr(Source$, Sep$)
  201.     counter% = 0
  202.     Do While i% > 0 And i% <= SourceLen%
  203.       If Not (counter% = 0 And i% = 1) Then counter% = counter% + 1
  204.       i% = InStr(i% + sepLen%, Source$, Sep$)
  205.     Loop
  206.     CountListItems% = counter%
  207.   End If
  208. End Function
  209.  
  210. Function ExtractFilePath$(ByVal F$)
  211. Dim PathName$
  212. PathName$ = F$
  213. F$ = exGetName$(F$)
  214. ExtractFilePath$ = Left$(PathName$, Len(PathName$) - Len(F$))
  215. End Function
  216.  
  217. Function GetWinIni$(pApp$, key$)
  218. Dim pDefault$
  219. If key$ = "" Then
  220.  
  221.    GetWinIni$ = GetWinIniList$(pApp$)
  222. Else
  223.     Dim x%
  224.     Dim ret As String * 1024
  225.     x% = GetPrivateProfileString(pApp$, key$, pDefault$, ret, Len(ret), "WIN.INI")
  226.     If x% > 0 Then GetWinIni$ = Left$(ret, x%)
  227. End If
  228.  
  229. End Function
  230.  
  231.  
  232. Function GetWinIniInt%(pApp$, pkey$)
  233. Dim pDefault%
  234. GetWinIniInt% = GetProfileInt(pApp$, pke